home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
inlin219.zip
/
INLINE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-04-26
|
55KB
|
2,024 lines
{Inline27}
(********* Source code Copyright 1986, by L. David Baldwin *********)
{$R-,S-,I+,F-,V-,B-,N-}
{$M 16384,0,655360 }
{
27 Vers 2.19 Fix CMP AX,-1, etc., incorrect in Vers 2.18.
26 Vers 2.18 Implement the sign extension bit for some instructions
25 Vers 2.17 Convert to Turbo 4.
24 Vers 2.16 Change byte size check in MemReg so the likes of
MOV [DI+$FE],AX will assemble right.
Allow ',' in DB pseudo op instruction.
23 Vers 2.15 Fix 'shl cl,1' which assembled as shl cl,cl
22 Vers 2.14 Change output format to better accomodate map file line numbers.
21 Vers 2.13 Allow JMP SHORT direct using symbols.
20 Vers 2.12 Allow CALL and JMP direct using symbols.
19 Vers 2.11
Fix bug in CallJmp and ShortJmp which didn't restrict short
jump range properly.
Fix bug which didn't allow CALL or JMP register. (CALL BX).
18 Vers 2.1
Fix bug in Accum which occasionally messed up IN and OUT instr.
Fix unintialized function in getnumber for quoted chars.
17 Vers 2.03
Change GetSymbol to accept about anything after '>' or '<'
Add 'NEW' pseudoinstruction.
Fix serious bug in defaultextension.
Add Wait_Already to prevent 2 'WAIT's from occuring.
Use 'tindex<maxbyte' comparison rather than <= which won't work
with integer comparison in this case.
}
PROGRAM Inline_Asm;
Const
CommentColumn = 25; {column where comments start in object file}
Symbolleng = 32; {maximum of 32 char symbols}
CR = 13; Lf = 10; Tab = 9;
Maxbyte = MaxInt;
BigStringSize = 127;
Signon1 : String[32] =
^M^J'Inline Assembler, Vers 2.19';
Signon2 : String[43] =
^M^J'(C) Copyright 1986-7 by L. David Baldwin'^M^J;
Type
FileString = String[64];
SymString = String[Symbolleng];
IndxReg = (BX, SI, DI, BP, None);
IndxSet = set of IndxReg;
PtrType = (BPtr, WPtr, DwPtr, QwPtr, TbPtr, UnkPtr); {keep order}
String4 = String[4];
String5 = Array[1..5] of Char;
Symtype = (Address, Disp8, Disp16, Othersym, EOLsym, Identifier, JmpDist,
LfBrack, RtBrack, Plus, Comma, STsym);
Table = Array[0..20] of SymString; {fake}
BigString = String[BigStringSize]; {125 chars on a turbo line}
Label_Info_ptr = ^Label_Info;
Label_Info = Record
Name : SymString;
ByteCnt : Integer;
Next : Label_Info_ptr;
end;
Fixup_Info_Ptr = ^Fixup_Info;
Fixup_Info = Record
Name : SymString;
Indx, Indx2, Fix_pt : Integer;
Jmptype : (Short, Med);
Prev, Next : Fixup_Info_Ptr;
end;
Var
NoAddrs, Aerr, Symbol, TheEnd, NewFnd, St_first,
Displace, WordSize, Wait_Already : Boolean;
Addr : Integer;
Sym : Symtype;
ModeByte, Reg1, Reg2, W1, W2, Sti_val : Integer;
SaveOfs, DataVal : Record
Symb : Boolean;
Sname : SymString;
Value : Integer;
end;
IRset : IndxSet;
Rmm, Md : Integer;
ByWord : PtrType;
Byt, SignExt : Byte;
Tindex, Tindex0, Column, I, ByteCount, LastSlash : Integer;
TextArray : Array[0..Maxbyte] of Char;
Lsid : SymString;
Str8 : Array[1..9] of Char; {the following 4 are at the same location}
Str : String5 Absolute Str8;
ID2 : Array[1..2] of Char Absolute Str8;
ID3 : Array[1..3] of Char Absolute Str8;
UCh, LCh : Char;
Chi, OldChi : Integer;
Out, Inn : Text;
Start_Col : Integer;
St : BigString;
Firstlabel, Pl : Label_Info_ptr;
Firstfix, Pf : Fixup_Info_Ptr;
{-------------DefaultExtension}
PROCEDURE DefaultExtension(Extension:FileString;Var Infile,Name :FileString);
{Given a filename, infile, add a default extension if none exists. Return
also the name without any extension.}
Var
I,J : Integer;
Temp : FileString;
begin
I:=Pos('..',Infile);
if I=0 then
Temp:=Infile
else
begin {a pathname starting with ..}
Temp:=Copy(Infile,I+2,64);
I:=I+1;
end;
J:=Pos('.',Temp);
if J=0 then
begin
Name := Infile;
Infile:=Infile+'.'+Extension;
end
else Name:=Copy(Infile,1,I+J-1);
end;
{-------------Space}
PROCEDURE Space(N : Integer);
Var I : Integer;
begin for I := 1 to N do Write(' '); end;
{-------------Error}
PROCEDURE Error(II : Integer; S : BigString);
begin
if not Aerr then
begin
WriteLn(St);
Space(Start_Col+II-4);
Write('^Error');
if Length(S) > 0 then
begin Write(', '); Write(S); end;
WriteLn;
Aerr := True;
end;
end;
{the following are definitions and variables for the parser}
Var
Segm, NValue : Integer;
Symname : SymString;
{end of parser defs}
{-------------GetCh}
PROCEDURE GetCh;
{return next char in uch and lch with uch in upper case.}
begin
if Chi <= Ord(St[0]) then LCh := St[Chi] else LCh := Chr(CR);
UCh := UpCase(LCh);
Chi := Chi+1;
end;
{-------------SkipSpaces}
PROCEDURE SkipSpaces;
begin
while (UCh = ' ') or (UCh = Chr(Tab)) do GetCh;
end;
{-------------GetDec}
FUNCTION GetDec(Var V : Integer) : Boolean;
Const Ssize = 8;
Var
S : String[Ssize];
Getd : Boolean;
Code : Integer;
begin
Getd := False;
S := '';
while (UCh >= '0') and (UCh <= '9') do
begin
Getd := True;
if Ord(S[0]) < Ssize then S := S+UCh;
GetCh;
end;
if Getd then
begin
Val(S, V, Code);
if Code <> 0 then Error(Chi, 'Bad number format');
end;
GetDec := Getd;
end;
{-------------GetHex}
FUNCTION GetHex(Var H : Integer) : Boolean;
Var Digit : Integer; {check for '$' before the call}
begin
H := 0; GetHex := False;
while (UCh in ['A'..'F', '0'..'9']) do
begin
GetHex := True;
if (UCh >= 'A') then Digit := Ord(UCh)-Ord('A')+10
else Digit := Ord(UCh)-Ord('0');
if H and $F000 <>0 then Error(Chi, 'Overflow');
H := (H Shl 4)+Digit;
GetCh;
end;
end;
{-------------GetNumber}
FUNCTION GetNumber(Var N : Integer) : Boolean;
{get a number and return it in n}
Var Term : Char;
Err : Boolean;
begin
N := 0;
if UCh = '(' then GetCh; {ignore ( }
if (UCh = '''') or (UCh = '"') then
begin
GetNumber := True;
Term := UCh; GetCh; Err := False;
while (UCh <> Term) and not Err do
begin
Err := N and $FF00 <> 0;
N := (N Shl 8)+Ord(LCh);
GetCh;
if Err then Error(Chi, 'Overflow');
end;
GetCh; {use up termination char}
end
else if UCh = '$' then
begin {a hex number}
GetCh;
if not GetHex(N) then Error(Chi, 'Hex number exp');
GetNumber := True;
end
else
GetNumber := GetDec(N); {maybe a decimal number}
if UCh = ')' then GetCh; {ignore an ending parenthesis}
end;
{-------------GetExpr}
FUNCTION GetExpr(Var Rslt : Integer) : Boolean;
Var
Rs1, Rs2, SaveChi : Integer;
Pos, Neg : Boolean;
begin
SaveChi := Chi;
GetExpr := False;
SkipSpaces;
Neg := UCh = '-';
Pos := UCh = '+';
if Pos or Neg then GetCh;
if GetNumber(Rs1) then
begin
GetExpr := True;
if Neg then Rs1 := -Rs1;
if (UCh = '+') or (UCh = '-') then
if GetExpr(Rs2) then
Rs1 := Rs1+Rs2; {getexpr will take care of sign}
Rslt := Rs1;
end
else
begin
Chi := SaveChi-1; GetCh;
end;
end;
{$v+}
{-------------GetSymbol}
FUNCTION GetSymbol(Var S : SymString) : Boolean;
Const Symchars : set of Char = ['A'..'Z', '0'..'9', '_', '+', '-','$','*'];
begin
if UCh in Symchars then
begin
GetSymbol := True;
S[0] := Chr(0);
while UCh in Symchars do
begin
if Ord(S[0]) < Symbolleng then S := S+UCh;
GetCh;
end
end
else GetSymbol := False;
end;
{$v-}
{-------------GetAddress}
FUNCTION GetAddress : Boolean;
Var Result : Boolean;
SaveChi : Integer;
begin
Result := False; SaveChi := Chi;
if GetExpr(Segm) then
begin
SkipSpaces;
if UCh = ':' then
begin
GetCh; SkipSpaces;
Result := GetExpr(NValue);
end;
end;
GetAddress := Result;
if not Result then
begin Chi := SaveChi-1; GetCh; end;
end;
{-------------ErrNull}
PROCEDU